home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ShareWare OnLine 2
/
ShareWare OnLine Volume 2 (CMS Software)(1993).iso
/
prog
/
lzw4p12.zip
/
SEE_ARC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-02-25
|
3KB
|
102 lines
(*
** SEE_ARC.PAS Copyright (C) 1993 by MarshallSoft Computing, Inc.
**
** This program is used to expand archive created with MK_ARC. For
** example, to un-archive all the files in 'PAS.ARF', type:
**
** SEE_ARC PAS.ARF
*)
program SEE_ARC;
uses dos, crt, memory, rw_io, hex_io, lzw_errs, dummy_io, LZW4P;
type
String12 = String[12];
AllocMemoryType = function(Size : Word) : Pointer;
FreeMemoryType = function(P : Pointer; Size : Word) : Integer;
Var
InpFileName : String12;
OutFileName : String12;
MemoryP : Pointer;
AllocMemoryP : Pointer;
FreeMemoryP : Pointer;
ReaderP : Pointer;
WriterP : Pointer;
Size : Integer;
Code : Integer;
i, x : Integer;
DirInfo : SearchRec;
Ratio : Real;
ReaderCnt : Real;
WriterCnt : Real;
Count : Integer;
AccumCnt : Integer;
begin (* SEE_ARC *)
(* get file specs *)
if ParamCount <> 1 then
begin
writeln('Usage: SEE_ARC <arc_file>');
halt;
end;
(* sign on *)
writeln('SEE_ARC 1.0: Type any key to abort...');
writeln;
Count := 0;
(* open input *)
InpFileName := ParamStr(1);
Code := ReaderOpen(InpFileName);
if Code <> 0 then
begin
writeln('Cannot open ',InpFileName,' for input. IOResult = ',Code);
halt;
end;
(* get pointers *)
AllocMemoryP := @AllocMemory;
FreeMemoryP := @FreeMemory;
ReaderP := @Reader;
WriterP := @Dummy;
(* Initialize LZW *)
Code := InitLZW(AllocMemoryP);
while TRUE do
begin
if KeyPressed then
begin
writeln;
writeln('Aborted by USER');
Halt;
end;
(* get filename from archive *)
OutFileName := '';
(* get 1st character, skipping any leading 0 *)
x := Reader;
if x = 0 then x := Reader;
repeat
if x = -1 then
begin
(* close input *)
Code := ReaderClose;
(* Terminate LZW *)
writeln;
writeln(Count,' files.');
Code := TermLZW(FreeMemoryP);
Halt;
end;
if x <> 0 then OutFileName := OutFileName + chr(x);
(* get next character from filename *)
x := Reader;
until x = 0;
Count := Count + 1;
(* open outut file *)
writeln(Count:3,' ',OutFileName);
Code := Expand(ReaderP,WriterP);
if Code < 0 then
begin
SayError(Code);
Halt;
end;
end; (* while *)
end.